perm filename TAX75.F4[TAX,LCS] blob
sn#206548 filedate 1976-03-15 generic text, type T, neo UTF8
00100 C***** INCOME TAX HELPER ******
00800 COMMON K,ACC,IOUT
00900 IOUT=5
01000 C**** 'B'=BACKUP ************** 'S' SKIPS SOME SECTIONS, 'SE' SKIPS TO END
01100 C*** UP TO 10 NUMBERS MAY BE ENTERED IF PROG. GIVES <CR> BEFORE ACCEPT.
01200 C 5=TTY 3=LPT
01300 ACC=-1
01400 TYPE 200
01500 ACCEPT 3,N
01600 IF(N.NE.'O')GO TO 60
01700 200 FORMAT(' N=NEW TAX WORK -- OR O=GET OLD FILE. H=HELP'/)
01800 TYPE 85
01900 ACCEPT 4,NAME
02000 GO TO 201
02100 33 FORMAT('+ STANDARD DEDUCTION - NOT MORE THAN $2000 OR $1000'/)
02200 60 FORMAT('+ TOTAL--- ',F10.2/)
02300 IF(N.NE.'H')GO TO 4
02400 TYPE 202
02500 CALL EXIT
02600 202 FORMAT(' ASK LCS FOR INFORMATION.')
02700 1 FORMAT(20F)
02800 2 FORMAT(F10.2/)
02900 3 FORMAT(A1)
03000 4 FORMAT(A5)
03100 I=' '
03200
03300 601 FORMAT(' ***** YOU ARE ON FORM 1040, PG.1 *****'/)
03400 WRITE(IOUT,601)
03500 IF(ACC.EQ.0)GO TO 102
03600 TYPE 604
03700 604 FORMAT(' TO BACKUP TYPE B '/)
03800 600 FORMAT('+ ARE YOU MARRIED, FILING SEPARATELY? '$)
03900 CALL TYP(3,I)
04000 TYPE 600
04100 ACCEPT 3,MFS
04200 IF(RIC.EQ.'S')GO TO 6901
04300 102 CALL TYP(7,I)
04400 WRITE(IOUT, 11)
04500 11 FORMAT('+ NUMBER OF EXEMPTIONS ',$)
04600 CALL ADUP(EX)
04700 IF(EX.EQ.'B')GO TO 600
04800 1100 CALL TYP(9,I)
04900 WRITE(IOUT, 12)
05000 12 FORMAT('+ WAGES, ETC. (FROM W2 FORMS) '/)
05100 CALL ADUP(WG)
05200 IF(WG.EQ.'B')GO TO 102
05300 103 CALL TYP(10,'A')
05400 WRITE(IOUT, 13)
05500 13 FORMAT('+ DIVIDENDS.'/)
05600 CALL ADUP(DT)
05700 IF(DT.EQ.'B')GO TO 102
05800 IF(DT.EQ.0)GO TO 105
05900 104 CALL TYP(10,'B')
06000 WRITE(IOUT, 14)
06100 14 FORMAT('+ DIVIDEND EXCLUSION. ',$)
06200 CALL ADUP(DEX)
06300 IF(DEX.EQ.'B')GO TO 103
06400 TOTD=DT-DEX
06500 CALL TYP(10,'C')
06600 WRITE(IOUT, 15)TOTD
06700 15 FORMAT('+ TOTAL DIVIDENDS. ',F11.2/)
06800 105 CALL TYP(11,I)
06900 WRITE(IOUT, 16)
07000 16 FORMAT('+ INTEREST INCOME. '/)
07100 CALL ADUP(RT)
07200 IF(RT.EQ.'B')GO TO 104
07300 106 CALL TYP(12,I)
07400 WRITE(IOUT, 17)
07500 17 FORMAT('+ OTHER INCOME.'/)
07600 602 FORMAT(' ***** GO TO PAGE 2 OF FORM 1040 *****'/,
07700 1' ***** TYPE S TO SKIP OVER SECTION AND RETURN TO PG.1'/
07800 1' ***** SE SKIPS TO LINE 44')
07900 IF(ACC.EQ.0.AND.T38.EQ.0)GO TO 1603
08000 WRITE(IOUT,602)
08100 CALL TYP(28,I)
08200 WRITE(IOUT, 18)
08300 18 FORMAT('+ BUSINESS INCOME-LOSS.'/)
08400 CALL ADUP(BI)
08500 IF(BI.EQ.-999)GO TO 1603
08600 IF(BI.EQ.'S')GO TO 6901
08700 IF(BI.EQ.'B')GO TO 105
08800 107 CALL TYP(29,'A')
08900 WRITE(IOUT, 19)
09000 19 FORMAT('+ CAPITAL ASSETS.'/)
09100 CALL ADUP(CA)
09200 IF(CA.EQ.'B')GO TO 106
09210 111 CALL TYP(29,'B')
09220 WRITE(IOUT, 23)
09230 23 FORMAT('+ 50% CAPITAL GAIN.'/)
09240 CALL ADUP(CP)
09250 IF(CP.EQ.'B')GO TO 107
09300 108 CALL TYP(30,I)
09400 WRITE(IOUT, 20)
09500 20 FORMAT('+ SUPPLEMENTAL SCHEDULE.'/)
09600 CALL ADUP(SU)
09700 IF(SU.EQ.'B')GO TO 111
09800 109 CALL TYP(31,'A')
09900 WRITE(IOUT, 21)
10000 21 FORMAT('+ RENTS, ROYALTIES, ETC.'/)
10100 CALL ADUP(RY)
10200 IF(RY.EQ.'B')GO TO 108
10300 110 CALL TYP(31,'B')
10400 WRITE(IOUT, 22)
10500 22 FORMAT('+ PENSIONS, ETC.'/)
10600 CALL ADUP(PE)
10700 IF(PE.EQ.'B')GO TO 109
11300 112 CALL TYP(33,I)
11400 WRITE(IOUT, 24)
11500 24 FORMAT('+ STATE INCOME TAX REFUNDS.'/)
11600 CALL ADUP(SI)
11700 IF(SI.EQ.'B')GO TO 111
11800 113 CALL TYP(34,I)
11900 WRITE(IOUT, 25)
12000 25 FORMAT('+ ALIMONY INCOME. '/)
12100 CALL ADUP(ALM)
12200 IF(ALM.EQ.'B')GO TO 112
12300 114 CALL TYP(35,I)
12400 WRITE(IOUT, 26)
12500 26 FORMAT('+ OTHER.'/)
12600 CALL ADUP(OT)
12700 IF(OT.EQ.'B')GO TO 113
12800 CALL TYP(36,I)
12900 T36=BI+CA+SU+RY+PE+CP+SI+ALM+OT
13000 WRITE(IOUT, 60)T36
13100 603 FORMAT(' ***** GO BACK TO PAGE 1 OF FORM 1040 *****'/)
13200 WRITE(IOUT,603)
13300 1603 CALL TYP(12,I)
13400 IF(BI.EQ.-999)BI=0
13500 WRITE(IOUT,60)T36
13600 CALL TYP(13,I)
13700 T13=WG+TOTD+RT+T36
13800 WRITE(IOUT, 60)T13
13900 115 CALL TYP(14,I)
14000 WRITE(IOUT, 27)
14100 27 FORMAT('+ ADJUSTMENTS TO INCOME'/)
14200
14300 IF(ACC.EQ.0.AND.T43.EQ.0)GO TO 1604
14400 WRITE(IOUT,602)
14500 CALL TYP(37,I)
14600 WRITE(IOUT, 28)
14700 28 FORMAT('+ SICK PAY. ',/)
14800 CALL ADUP(SICK)
14900 IF(SICK.EQ.-999)GO TO 1604
15000 IF(SICK.EQ.'S')GO TO 6901
15100 IF(SICK.EQ.'B')GO TO 114
15200 116 CALL TYP(38,I)
15300 WRITE(IOUT, 29)
15400 29 FORMAT('+ MOVING EXPENSES. ',/)
15500 CALL ADUP(RMEX)
15600 IF(RMEX.EQ.'B')GO TO 115
15700 117 CALL TYP(39,I)
15800 WRITE(IOUT, 30)
15900 30 FORMAT('+ EMPLOYEE BUSINESS EXPENSES.'/)
16000 CALL ADUP(EB)
16100 IF(EB.EQ.'B')GO TO 116
16200 118 CALL TYP(40,'B')
16300 WRITE(IOUT, 31)
16400 31 FORMAT('+ SELF-EMPLOYED RETIREMENT PLAN. '/)
16500 CALL ADUP(SER)
16600 IF(SER.EQ.'B')GO TO 117
16700 CALL TYP(42,I)
16800 T42=SICK+RMEX+EB+SER
16900 WRITE(IOUT, 60)T42
17000
17100 WRITE(IOUT,603)
17200 1604 CALL TYP(14,I)
17300 IF(SICK.EQ.-999)SICK=0
17400 WRITE(IOUT, 60)T42
17500 T15=T13-T42
17600 CALL TYP(15,I)
17700 WRITE(IOUT, 32)T15
17800 32 FORMAT('+ ADJUSTED GROSS INCOME.',F13.2/)
17900 IF(T15.LT.10000.)CALL SMALL(T15)
18000 CALL STDED(T15)
18100 IF(ACC)WRITE(IOUT, 34)
18200 34 FORMAT(/' ***** ITEMIZE DEDUCTIONS? '$)
18300 IF(ACC)ACCEPT 3,JIT
18400 IF(JIT.EQ.'N')GO TO 6900
18500 C*************************************
18600 119 WRITE(IOUT, 35)
18700 35 FORMAT(/' ***** GO TO SCHEDULE A *****')
18800 WRITE(IOUT, 36)
18900 36 FORMAT(/' ----- MEDICAL - DENTAL '/)
19000 IF(ACC.EQ.0)GO TO 3700
19100 CALL TYP(1,I)
19200 WRITE(IOUT, 37)
19300 37 FORMAT('+ TOTAL OF INSURANCE PREMIUMS. '/)
19400 CALL ADUP(RMI)
19500 IF(RMI.EQ.'B')GO TO 118
19600 3700 T1=RMI/2.
19700 IF(T1.GT.150.)T1=150.
19800 CALL TYP(1,I)
19900 WRITE(IOUT, 2)T1
20000 120 CALL TYP(2,I)
20100 WRITE(IOUT, 38)
20200 38 FORMAT('+ MEDICINE AND DRUGS. '/)
20300 CALL ADUP(RM)
20400 IF(RM.EQ.'B')GO TO 119
20500 CALL TYP(3,I)
20600 61 FORMAT('+ 1% OF LINE 15-- ',F10.2/)
20700 ONP=T15/100.
20800 WRITE(IOUT, 61)ONP
20900 T4=RM-ONP
21000 IF(T4)T4=0
21100 CALL TYP(4,I)
21200 WRITE(IOUT, 2)T4
21300 CALL TYP(5,I)
21400 T5=RMI-T1
21500 IF(T5)T5=0
21600 62 FORMAT('+ BALANCE OF INSURANCE PREMIUMS. ',F10.2/)
21700 WRITE(IOUT, 62)T5
21800 CALL TYP(6,I)
21900 WRITE(IOUT, 39)
22000 39 FORMAT('+ OTHER MEDICAL AND DENTAL EXPENSES.'/)
22100 121 CALL TYP(6,'A')
22200 WRITE(IOUT, 40)
22300 40 FORMAT('+ DOCTORS, DENTISTS, ETC.'/)
22400 CALL ADUP(DO)
22500 IF(DO.EQ.'B')GO TO 120
22600 122 CALL TYP(6,'B')
22700 WRITE(IOUT, 41)
22800 41 FORMAT('+ HOSPITALS.'/)
22900 CALL ADUP(HOSP)
23000 IF(HOSP.EQ.'B')GO TO 121
23100 123 CALL TYP(6,'C')
23200 WRITE(IOUT, 26)
23300 CALL ADUP(DOTH)
23400 IF(DOTH.EQ.'B')GO TO 122
23500 T7=T4+T5+DO+HOSP+DOTH
23600 CALL TYP(7,I)
23700 WRITE(IOUT, 60)T7
23800 T8=T15*.03
23900 CALL TYP(8,I)
24000 WRITE(IOUT, 2)T8
24100 T9=T7-T8
24200 IF(T9)T9=0
24300 CALL TYP(9,I)
24400 WRITE(IOUT, 2)T9
24500 T10=T9+T1
24600 CALL TYP(10,I)
24700 WRITE(IOUT, 60)T10
24800 CALL TYP(35,I)
24900 WRITE(IOUT, 60)T10
25000
25100 43 FORMAT(/' ----- TAXES'/)
25200 WRITE(IOUT, 43)
25300 124 CALL TYP(11,I)
25400 WRITE(IOUT, 44)
25500 44 FORMAT('+ STATE AND LOCAL INCOME.'/)
25600 CALL ADUP(TA)
25700 IF(TA.EQ.'B')GO TO 123
25800 125 CALL TYP(12,I)
25900 WRITE(IOUT, 45)
26000 45 FORMAT('+ REAL ESTATE.'/)
26100 CALL ADUP(RX)
26200 IF(RX.EQ.'B')GO TO 124
26300 126 CALL TYP(13,I)
26400 WRITE(IOUT, 42)
26500 42 FORMAT('+ GASOLINE TAX (SEE TABLES) '/)
26600 CALL ADUP(GTAX)
26700 IF(GTAX.EQ.'B')GO TO 125
26800 127 CALL TYP(14,I)
26900 WRITE(IOUT, 46)
27000 46 FORMAT('+ GENERAL SALES. (SEE TABLES) '/)
27100 CALL ADUP(STAX)
27200 IF(STAX.EQ.'B')GO TO 126
27300 128 CALL TYP(15,I)
27400 WRITE(IOUT, 47)
27500 47 FORMAT('+ PERSONAL PROPERTY'/)
27600 CALL ADUP(PTAX)
27700 IF(PTAX.EQ.'B')GO TO 127
27800 129 CALL TYP(16,I)
27900 WRITE(IOUT, 26)
28000 CALL ADUP(XO)
28100 IF(XO.EQ.'B')GO TO 128
28200 CALL TYP(17,I)
28300 T17=TA+RX+GTAX+STAX+PTAX+XO
28400 WRITE(IOUT, 60)T17
28500 CALL TYP(36,I)
28600 WRITE(IOUT, 60)T17
28700 130 WRITE(IOUT, 48)
28800 48 FORMAT(/' ----- INTEREST EXPENSE'/)
28900 CALL TYP(18,I)
29000 WRITE(IOUT, 49)
29100 49 FORMAT('+ HOME MORTGAGE.'/)
29200 CALL ADUP(RMO)
29300 IF(RMO.EQ.'B')GO TO 129
29400 131 CALL TYP(19,I)
29500 WRITE(IOUT, 26)
29600 CALL ADUP(ROH)
29700 IF(ROH.EQ.'B')GO TO 130
29800 CALL TYP(20,I)
29900 T20=RMO+ROH
30000 WRITE(IOUT, 60)T20
30100 CALL TYP(37,I)
30200 WRITE(IOUT, 60)T20
30300
30400 132 WRITE(IOUT, 50)
30500 50 FORMAT(/' ----- CONTRIBUTIONS '/)
30600 CALL TYP(21,'A')
30700 WRITE(IOUT, 51)
30800 51 FORMAT('+ CASH CONTRIBUTIONS.'/)
30900 CALL ADUP(CO)
31000 IF(CO.EQ.'B')GO TO 131
31100 133 CALL TYP(21,'B')
31200 WRITE(IOUT, 26)
31300 CALL ADUP(OC)
31400 IF(OC.EQ.'B')GO TO 132
31500 134 CALL TYP(22,I)
31600 WRITE(IOUT, 510)
31700 510 FORMAT('+ OTHER THAN CASH (SEE PAGE 12).'/)
31800 CALL ADUP(OCA)
31900 IF(OCA.EQ.'B')GO TO 133
32000 135 CALL TYP(23,I)
32100 WRITE(IOUT, 52)
32200 52 FORMAT('+ CARRY OVER FROM PRIOR YEARS.'/)
32300 CALL ADUP(PRIOR)
32400 IF(PRIOR.EQ.'B')GO TO 134
32500 136 CALL TYP(24,I)
32600 T24=PRIOR+OCA+OC+CO
32700 WRITE(IOUT, 60)T24
32800 CALL TYP(38,I)
32900 WRITE(IOUT, 60)T24
33000 137 WRITE(IOUT, 53)
33100 53 FORMAT(/' ----- CASUALTY OR THEFT LOSSES'/)
33200 CALL TYP(25,I)
33300 54 FORMAT('+ LOSS BEFORE INSURANCE REIMBURSEMENT.'/)
33400 WRITE(IOUT, 54)
33500 CALL ADUP(RLOSS)
33600 IF(RLOSS.EQ.'B')GO TO 135
33700 IF(RLOSS.EQ.0)GO TO 139
33800 138 CALL TYP(26,I)
33900 WRITE(IOUT, 55)
34000 55 FORMAT('+ INSURANCE REIMBURSEMENT.'/)
34100 CALL ADUP(RIR)
34200 IF(RIR.EQ.'B')GO TO 137
34300 CALL TYP(27,I)
34400 T27=RLOSS-RIR
34500 IF(T27)T27=0
34600 WRITE(IOUT, 60)T27
34700 T28=100.
34800 IF(T27.LT.T28)T28=T27
34900 CALL TYP(28,I)
35000 WRITE(IOUT, 2)T28
35100 T29=T27-T28
35200 CALL TYP(29,I)
35300 WRITE(IOUT, 60)T29
35400 CALL TYP(39,I)
35500 WRITE(IOUT, 60)T29
35600 139 WRITE(IOUT, 56)
35700 56 FORMAT(/' ----- MISCELLANEOUS DEDUCTIONS '/)
35800 CALL TYP(30,I)
35900 WRITE(IOUT, 57)
36000 57 FORMAT('+ ALIMONY PAID.'/)
36100 CALL ADUP(ALIMON)
36200 IF(ALIMON.EQ.'B')GO TO 138
36300 140 CALL TYP(31,I)
36400 WRITE(IOUT, 58)
36500 58 FORMAT('+ UNION DUES.'/)
36600 CALL ADUP(UN)
36700 IF(UN.EQ.'B')GO TO 139
36800 141 CALL TYP(32,I)
36900 WRITE(IOUT, 59)
37000 59 FORMAT('+ CHILD AND DEPENDENT CARE(FORM 2441)'/)
37100 CALL ADUP(CAD)
37200 IF(CAD.EQ.'B')GO TO 140
37300 142 CALL TYP(33,I)
37400 WRITE(IOUT, 26)
37500 CALL ADUP(SOTH)
37600 IF(SOTH.EQ.'B')GO TO 141
37700 T34=ALIMONY+UN+CAD+SOTH
37800 CALL TYP(34,I)
37900 WRITE(IOUT, 60)T34
38000 CALL TYP(40,I)
38100 WRITE(IOUT, 60)T34
38200 WRITE(IOUT, 63)
38300 63 FORMAT(' ----- SUMMARY OF DEDUCTIONS.'/)
38400 CALL TYP(35,I)
38500 WRITE(IOUT, 64)T10
38600 64 FORMAT('+ MEDICAL AND DENTAL.',F12.2/)
38700 CALL TYP(36,I)
38800 WRITE(IOUT, 65)T17
38900 65 FORMAT('+ TOTAL TAXES.',F12.2/)
39000 650 FORMAT('+ TOTAL INTEREST.',F12.2/)
39100 66 FORMAT('+ TOTAL CONTRIBUTIONS.',F12.2/)
39200 67 FORMAT('+ CASUALTY OR THEFT LOSS.',F12.2/)
39300 68 FORMAT('+ TOTAL MISCELLANEAOUS.',F12.2/)
39400 69 FORMAT('+ TOTAL DEDUCTIONS.',F12.2/)
39500 CALL TYP(37,I)
39600 WRITE(IOUT, 650)T20
39700 CALL TYP(38,I)
39800 WRITE(IOUT, 66)T24
39900 CALL TYP(39,I)
40000 WRITE(IOUT, 67)T29
40100 CALL TYP(40,I)
40200 WRITE(IOUT, 68)T34
40300 CALL TYP(41,I)
40400 T41=T34+T29+T20+T17+T10
40500 WRITE(IOUT, 69)T41
40600
40700 WRITE(IOUT,602)
40800 6900 CALL TYP(43,I)
40900 WRITE(IOUT,32)T15
41000 IF(JIT.NE.'Y')GO TO 6901
41100 CALL TYP(44,'A')
41200 WRITE(IOUT, 69)T41
41300 6901 T44B=T15*.15
41400 X=2300
41500 IF(MFS.EQ.'Y')X=1300
41600 IF(T44B.GT.X)T44B=X
41700 CALL TYP(44,'B')
41800 WRITE(IOUT, 69)T44B
41900 T45=T15-T41
42000 T45B=T15-T44B
42100 IF(JIT.NE.'Y')GO TO 6902
42200 CALL TYP(45,'A')
42300 WRITE(IOUT, 2)T45
42400 6902 CALL TYP(45,'B')
42500 WRITE(IOUT, 2)T45B
42600 CALL TYP(46,I)
42700 X=EX*750
42800 WRITE(IOUT, 70)X
42900 70 FORMAT('+ EXEMPTIONS X $750.',F12.2/)
43000 IF(JIT.NE.'Y')GO TO 71
43100 CALL TYP(47,'A')
43200 T47=T45-X
43300 WRITE(IOUT, 71)T47
43400 71 FORMAT('+ TAXABLE INCOME -- ',F12.2/)
43500 T47B=T45B-X
43600 CALL TYP(47,'B')
43700 WRITE(IOUT, 71)T47B
43800 7216 WRITE(IOUT, 72)
43900 72 FORMAT(//' FIGURE YOUR TAX WITH SCHED. X,Y OR Z.'/
44000 1' USE SMALLEST OF 47A OR 47B (UNLESS ZERO).'/)
44100 IF(ACC.EQ.0)GO TO 73
44200 1722 TYPE 722
44300 722 FORMAT(' TYPE APPROPRIATE $, % AND $ FROM LAST 2 COLUMNS OF
44400 1SCHEDULES X, Y OR Z.'/)
44500 ACCEPT 1,X,Y,Z
44600 IF(X.EQ.'B')GO TO 142
44700 IF(Y.LT.1)GO TO 1722
44800 C TYPE PERCENTAGE AS NON-DECIMAL NUM. I.E. 25=25% NOT! .25
44900 IF(T47.LE.Z)GO TO 1722
45000 IF(JIT.NE.'Y')T47=T47B
45100 TAX=X+(T47-Z)*Y/100.
45200 CC TAXB=X+(T47B-Z)*Y/100.
45300 73 FORMAT('+ YOUR TAX -- ',F12.2/)
45400 CALL TYP(16,I)
45500 WRITE(IOUT,73)TAX
45600 CC CALL TYP(16,'B')
45700 CC WRITE(IOUT,73)TAXB
45800 C****** CREDITS ********************
45900 741 FORMAT(' ----- CREDITS'/)
46000 WRITE(IOUT,741)
46100
46200 IF(ACC.EQ.0.AND.T54.EQ.0)GO TO 1605
46300 1742 WRITE(IOUT,602)
46400 CALL TYP(48,I)
46500 742 FORMAT('+ RETIREMENT INCOME CREDIT. (SCHED. R) '/)
46600 WRITE(IOUT,742)
46700 CALL ADUP(RIC)
46800 IF(RIC.EQ.'S')GO TO 6901
46900 IF(RIC.EQ.-999)GO TO 1605
47000 IF(RIC.EQ.'B')GO TO 7216
47100 743 FORMAT('+ INVESTMENT CREDIT. (FORM 3468) '/)
47200 CALL TYP(49,I)
47300 WRITE(IOUT,743)
47400 CALL ADUP(RIVC)
47500 IF(RIVC.EQ.'B')GO TO 742
47600 744 FORMAT('+ FOREIGN TAX CREDIT. (FORM 1116) '/)
47700 CALL TYP(50,I)
47800 WRITE(IOUT,744)
47900 CALL ADUP(FTX)
48000 IF(FTX.EQ.'B')GO TO 743
48100 745 FORMAT('+ CREDIT FOR CONTRBS. TO CANDS. (SEE PG.9) '/)
48200 CALL TYP(51,I)
48300 WRITE(IOUT,745)
48400 CALL ADUP(CCC)
48500 IF(CCC.EQ.'B')GO TO 744
48600 746 FORMAT('+ WORK INCENTIVE CREDIT. (FORM 4874) '/)
48700 CALL TYP(52,I)
48800 WRITE(IOUT,746)
48900 CALL ADUP(WIC)
49000 IF(WIC.EQ.'B')GO TO 745
49010 1745 FORMAT('+ NEW RESID. '/)
49020 CALL TYP(53,I)
49030 WRITE(IOUT,1745)
49040 CALL ADUP(PUR)
49050 IF(PUR.EQ.'B')GO TO 746
49100 CALL TYP(54,I)
49200 T54=RIC+FTX+CCC+WIC+RIVC+PUR
49300 WRITE(IOUT,60)T54
49400 C******************************* PAGE 1 AGAIN ***********
49500 WRITE(IOUT,603)
49600 1605 CALL TYP(17,I)
49700 IF(RIC.EQ.-999)RIC=0
49800 WRITE(IOUT, 74)T54
49900 74 FORMAT('+ TOTAL CREDITS.',F12.2/)
50000 T18=TAX-T54
50100 CALL TYP(18,I)
50200 WRITE(IOUT, 75),T18
50300 75 FORMAT('+ ******** INCOME TAX ******',F12.2/)
50400 C******** BACK TO PAGE 2 **************************
50500 760 FORMAT('+ SELF-EMPLOYMENT TAX. (SCHED. SE) [OUT OF ORDER]'/)
50600 IF(ACC.EQ.0.AND.T61.EQ.0)GO TO 1606
50700 1760 WRITE(IOUT,602)
50800 CALL TYP(59,I)
50900 WRITE(IOUT,760)
51000 CALL ADUP(SETX)
51100 IF(SETX.EQ.-999)GO TO 1606
51200 IF(SETX.EQ.'S')GO TO 6901
51300 IF(SETX.EQ.'B')GO TO 74
51400 761 FORMAT('+ TAX FROM RECOMPUTING INV.(FORM 4255) '/)
51500 CALL TYP(55,I)
51600 WRITE(IOUT,761)
51700 CALL ADUP(TRI)
51800 IF(TRI.EQ.'B')GO TO 760
51900 762 FORMAT('+ TAX FROM RECOMPUTING WIN. (+ SCHED.) '/)
52000 CALL TYP(56,I)
52100 WRITE(IOUT,762)
52200 CALL ADUP(TRW)
52300 IF(TRW.EQ.'B')GO TO 761
52400 763 FORMAT('+ MINIMUM TAX? (FORM 4625) '/)
52500 CALL TYP(57,I)
52600 WRITE(IOUT,763)
52700 CALL ADUP(RMT)
52800 IF(RMT.EQ.'B')GO TO 762
52900 764 FORMAT('+ SOCIAL SECURITY TAX ON TIPS. (FORM 4137) '/)
53000 CALL TYP(60,I)
53100 WRITE(IOUT,764)
53200 CALL ADUP(SST)
53300 IF(SST.EQ.'B')GO TO 763
53400 765 FORMAT('+ UNCOLLECTED SOC. SEC. TAX ON TIPS. '/)
53500 CALL TYP(61,I)
53600 WRITE(IOUT,765)
53700 CALL ADUP(TIPS)
53800 IF(TIPS.EQ.'B')GO TO 764
53805 758 FORMAT('+ PREM. DISTS. '/)
53810 CALL TYP(58,I)
53815 WRITE(IOUT,758)
53820 CALL ADUP(PREM)
53825 IF(PREM.EQ.'B')GO TO 765
53830 662 FORMAT('+ EXCESS CONTR.'/)
53840 CALL TYP(62,I)
53850 WRITE(IOUT,662)
53860 CALL ADUP(EXC)
53870 IF(EXC.EQ.'B')GO TO 758
53900 CALL TYP(63,I)
54000 T63=TIPS+SST+RMT+TRW+TRI+SETX+PREM+EXC
54100 WRITE(IOUT,60)T63
54200
54300 C***** BACK TO PG.1 *******
54400 WRITE(IOUT,603)
54500 1606 CALL TYP(19,I)
54600 IF(SETX.EQ.-999)SETX=0
54700 WRITE(IOUT, 76)T63
54800 76 FORMAT('+ OTHER TAXES (LINE 63). ',F12.2/)
54900 T20T=TAX+T63
55000 CALL TYP(20,I)
55100 WRITE(IOUT, 60)T20T
55200 7721 CALL TYP(21,'A')
55300 77 FORMAT('+ FEDERAL TAX WITHHELD.'/)
55400 WRITE(IOUT, 77)
55500 CALL ADUP(WT)
55600 IF(WT.EQ.'B')GO TO 75
55700 CALL TYP(21,'A')
55800 WRITE(IOUT, 60)WT
55900 78 FORMAT('+ 1973 ESTIMATED TAX PAYMENTS.'/)
56000 CALL TYP(21,'B')
56100 WRITE(IOUT, 78)
56200 CALL ADUP(ET)
56300 IF(ET.EQ.'B')GO TO 77
56400 79 FORMAT('+ AMOUNT PAID WITH FORM 4868. '/)
56500 CALL TYP(21,'C')
56600 WRITE(IOUT, 79)
56700 CALL ADUP(FORM)
56800 IF(FORM.EQ.'B')GO TO 78
56900 80 CALL TYP(21,'D')
57000 WRITE(IOUT, 26)
57100
57200 IF(ACC.EQ.0.AND.T65.EQ.0)GO TO 1607
57300 WRITE(IOUT,602)
57400 800 FORMAT('+ EXCESS FICA TAX WITHHELD. (SEE PG.9) '/)
57500 CALL TYP(64,I)
57600 WRITE(IOUT,800)
57700 CALL ADUP(FIC)
57800 IF(FIC.EQ.'B')GO TO 78
57900 IF(FIC.EQ.-999)GO TO 1607
58000 IF(FIC.EQ.'S')GO TO 6901
58100 801 FORMAT('+ CREDIT FOR FED. TAX ON FUELS. (FORM 4136) '/)
58200 CALL TYP(65,I)
58300 WRITE(IOUT,801)
58400 CALL ADUP(FUEL)
58500 IF(FUEL.EQ.'B')GO TO 800
58600 802 FORMAT('+ CREDIT FROM REGULATED INVSTMT. CO. (FORM 2439) '/)
58700 CALL TYP(66,I)
58800 WRITE(IOUT,802)
58900 CALL ADUP(CRICC)
59000 IF(CRICC.EQ.'B')GO TO 801
59100 T65=FIC+FUEL+CRICC
59200 CALL TYP(65,T54,I)
59300 WRITE(IOUT,60)T65
59400
59500 WRITE(IOUT,603)
59600 1607 CALL TYP(21,'D')
59700 IF(FIC.EQ.-999)FIC=0
59800 WRITE(IOUT, 26)
59900 IF(ACC.EQ.0)WRITE(IOUT,2)T65
60000 T22=WT+ET+FORM+T65
60100 CALL TYP(22,I)
60200 WRITE(IOUT, 60)T22
60300 T23=T20T-T22
60400 T23T=T23
60500 IF(T23T)T23T=0
60600 CALL TYP(23,I)
60700 82 FORMAT('+ BALANCE DUE. ------ ',F12.2/)
60800 WRITE(IOUT, 82)T23T
60900 T23=-T23
61000 IF(T23)T23=0
61100 CALL TYP(24,I)
61200 WRITE(IOUT, 83)T23
61300 83 FORMAT('+ OVERPAID ---------- ',F12.2)
61400 CALL TYP(25,I)
61500 WRITE(IOUT, 84)T23
61600 84 FORMAT('+ REFUNDED TO YOU --- ',F12.2)
61700 IF(IOUT.EQ.3)CALL EXIT
61800 IF(ACC.EQ.0)GO TO 860
61900 WRITE(IOUT, 85)
62000 85 FORMAT(//' TYPE FILE NAME. '$)
62100 ACCEPT 4,NAME
62200 CALL OFILE(1,NAME)
62300 WRITE(1)
62400 1 RIC,FTX,CCC,WIC,RIVC,TIPS,SST,RMT,
62500 1 TRW,TRI,SETX,FUEL,CRICC,FIC,ET,
62600 1 JIT,T63,T65,T54,
62700 1 EX,WG,DT,DEX,TOTD,RT,BI,CA,CP,SU,RY,PE,SI,
62800 1 ALM,OT,T36,T13,SICK,RMEX,EB,SER,T42,T15,RMI
62900 1,T1,RM,T4,T5,DO,HOSP,DOTH,T7,T8,T9,T10,TA,RX,GTAX,STAX
63000 WRITE(1)PTAX,XO,T17,RMO,ROH,T20,CO,OC,OCA,PRIOR,T24,RLOSS,RIR,
63100 1 T27,T28,T29,ALIMON,UN,SOTH,T34,T10,T17,T41,T44B,T45,T45B
63200 1,T47,T47B,TAX,T18,CRED,T20T,WT,FORM,T22,OTX
63300 1,T23T,T23,K
63400 GO TO 5
63500 201 CALL IFILE(21,NAME)
63600 READ(21)
63700 1 RIC,FTX,CCC,WIC,RIVC,TIPS,SST,RMT,
63800 1 TRW,TRI,SETX,FUEL,CRICC,FIC,ET,
63900 1 JIT,T63,T65,T54,
64000 1 EX,WG,DT,DEX,TOTD,RT,BI,CA,CP,SU,RY,PE,SI,
64100 1 ALM,OT,T36,T13,SICK,RMEX,EB,SER,T42,T15,RMI
64200 1,T1,RM,T4,T5,DO,HOSP,DOTH,T7,T8,T9,T10,TA,RX,GTAX,STAX
64300 READ(21)PTAX,XO,T17,RMO,ROH,T20,CO,OC,OCA,PRIOR,T24,RLOSS,RIR,
64400 1 T27,T28,T29,ALIMON,UN,SOTH,T34,T10,T17,T41,T44B,T45,T45B
64500 1,T47,T47B,TAX,T18,CRED,T20T,WT,FORM,T22,OTX
64600 1,T23T,T23,K
64700 860 TYPE 86
64800 86 FORMAT(' R=REWORK, T=TYPE ON TTY, L=LIST ON LPT.'/)
64900 ACCEPT 3,N
65000 IF(N.EQ.'R')GO TO 87
65100 ACC=0
65200 IF(N.EQ.'T')GO TO 4
65300 IOUT=3
65400 GO TO 4
65500 87 TYPE 88
65600 88 FORMAT(' START AT LINE 9,16,21,28,39,44,49,55,62 -- OR IN
65700 1 SCHED. A, 1,11,18,25,30?'/)
65800 ACCEPT 1,X
65900 K=X
66000 IF(K.GT.30)GO TO 89
66100 GO TO(119,1,1,1,1,1,1,1, 1100,1, 43,1,1,1,1, 7216,1, 130,
66200 1 1,1, 7721,1,1,1, 137,1,1, 17,1, 139)K
66300 89 J=K-38
66400 GO TO(27,1,1,1,1,6900)J
66500 IF(K.EQ.49)GO TO 1742
66600 IF(K.EQ.55)GO TO 1760
66700 IF(K.EQ.62)GO TO 800
66800 5 END